home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / workbench / boot / czesc_2 / smsrc / sm / scrolltext.pas < prev    next >
Pascal/Delphi Source File  |  1995-07-11  |  3KB  |  127 lines
  1. { get some strings from a file }
  2. Function GetWitComment;
  3.     
  4. VAR
  5.     ap          : pAnchorPath;
  6.     filenames   : Array[0..10] of string[180];
  7.     pf          : string[180];
  8.     s, ts       : string;
  9.     seekin, n, 
  10.     oldpos      : longint;
  11.     witf        : BPTR;
  12.     fib         : pFileInfoBlock;
  13.     pBuf        : STRPTR;
  14.     buf         : String;
  15.     OK          : Boolean;
  16.     err         : integer;
  17.  
  18.     
  19. begin
  20.     ap := AllocMem(sizeof(tAnchorPath)+256, MEMF_CLEAR);
  21.     if ap <> NIL then begin
  22.         ap^.ap_StrLen := 255;
  23.         err := MatchFirst(CSCPAR(@RememberKey, 'S:SM/#?.WIT'), ap);
  24.         n := 0;
  25.         While (err = 0) and (n <= 10) do begin
  26.             filenames[n] := PtrToPas(@ap^.ap_buf);
  27.             inc(n);
  28.             err := MatchNext(ap);
  29.         end;
  30.         MatchEnd(ap);
  31.         FreeMem_(ap, sizeof(tAnchorPath)+256);
  32.  
  33.         S := '';
  34.         If n <> 0 then begin
  35.             { get a random file name }
  36.             Randomize;
  37.             pf := filenames[Random(n)] + #0;
  38.         
  39.             witf := Open(@pf[1], MODE_OLDFILE);
  40.             if witf <> NULL then begin
  41.                 { examine FH }
  42.                 fib := AllocMem(sizeof(tFileInfoBlock), MEMF_CLEAR);
  43.                 if fib <>NIL then begin
  44.                     if ExamineFH(witf, fib) then begin;
  45.                     
  46.                         seekin := Random(fib^.fib_Size);
  47.                         oldpos := Seek_(witf, seekin, OFFSET_BEGINNING);
  48.                         { goto next line }
  49.                         pBuf := FGets(witf, @buf, 255);
  50.             
  51.                         OK := True;
  52.                         while OK do begin
  53.                             pBuf := FGets(witf, @buf, 255);
  54.                             if pBuf <> NIL then begin
  55.                                 ts := PtrToPas(pbuf);
  56.                                 if NOT ((ts[1] = ';') or ((ts[1] = '#') and (ts[2] = '#'))) then begin
  57.                                     if ts[length(ts)] = #10 then 
  58.                                         ts := Copy(ts, 0, length(ts)-1);
  59.                                     if NOT (length(s) + 6 + length(ts) > 254) then
  60.                                         s := s + ' -!- ' + ts
  61.                                     else
  62.                                         OK := False;
  63.                                 end;
  64.                             end else begin
  65.                                 oldpos := Seek_(witf, 0, OFFSET_BEGINNING);
  66.                                 pBuf := FGets(witf, @buf, 255);
  67.                                 ts := PtrToPas(pbuf);
  68.                                 if NOT ((ts[1] = ';') or ((ts[1] = '#') and (ts[2] = '#'))) then begin
  69.                                     if ts[length(ts)] = #10 then 
  70.                                         ts := Copy(ts, 0, length(ts)-1);
  71.                                     if NOT (length(s) + 6 + length(ts) > 254) then
  72.                                          s := s + ' -!- ' + ts
  73.                                      else
  74.                                         OK := False;
  75.                                 end;
  76.                             end;
  77.                         end;
  78.                         s:= s + ' -!- ';
  79.                     end;
  80.                     FreeMem_(fib,sizeof(tFileInfoBlock));
  81.                 end;
  82.                 OK := Close_(WitF);
  83.             end else s := 'No .WIT files found -!- '+SMVer;
  84.         end;
  85.         { return string }
  86.         getwitcomment := s;
  87.     end;
  88. end;
  89.  
  90. { scroll the text within given rectangle }
  91. Procedure ScrollText;
  92.  
  93. VAR 
  94.     te : tTextExtent;
  95.     t  : long;
  96.                                 
  97. Begin
  98.     { Erase the area that text will currently be displayed in }
  99.      EraseRect(RPort, L, B-H, L+W, B+1);
  100.      If NOT (count > W) then begin
  101. {                                  *----------*
  102.   text is scrolling from the right |       <--|
  103.                                    *----------*
  104. }
  105.          Move_(RPort, L+W-count, B);
  106.         t := TextFit(RPort, @txt[1], length(txt), @te, NIL, 1, W-(L+W-count-L), H);
  107.         Text_(RPort, @txt[1], t);
  108.         if count+RPort^.Font^.tf_XSize >= W then count := W+1
  109.          else    count := count+RPort^.Font^.tf_XSize;
  110.     end else begin
  111. {                                   *----------*
  112.   Text is scrolling off to the left |---<      |
  113.                                     *----------*
  114. }
  115.         Move_(RPort, L, B);
  116.         t := TextFit(RPort, @txt[count-W], length(txt)-(count-W)+1, @te, NIL, 1, W, H);
  117.         Text_(RPort, @txt[count-W], t);
  118.         count := count+1;
  119.     end;
  120.     if count > W+length(txt)+1 then count := 1;
  121. { NOTE: there may be a slight jump or speed decrease 
  122.   during the transition between the two states.}
  123. end;
  124.   
  125.     
  126.      
  127.